home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cagraph.arc / CAGRAPH.BAS (.txt)
Encoding:
GW-BASIC  |  1986-01-27  |  18.8 KB  |  895 lines
  1. 210  '
  2. 220  '
  3. 230  ' INITIALIZATION
  4. 240  CLEAR,,,32768
  5. 250  DEF SEG
  6. 260  DEFINT A-Z
  7. 270  SCREEN 1
  8. 280  COLOR 1,0
  9. 290  KEY OFF
  10. 300  CLS
  11. 310  '
  12. 320  ' DEFINE ALL ARRAY VARIABLES
  13. 330  DIM CURSRBOX(91),MENU(9001),WORK(9001)
  14. 340  DIM MESSAGE(281),COLORNAME$(7),LABEL(321)
  15. 350  '
  16. 360  ' GET THE BLANK SCREEN FOR LATER PANIC
  17. 370  GET (0,0)-(319,199),WORK
  18. 380  '
  19. 390  ' PRELIMINARY MESSAGE TO PREVENT USER PANIC
  20. 400  LOCATE 12,5
  21. 410  PRINT "-IF A HARDCOPY OF THE SCREEN IS WANTED"
  22. 412  LOCATE 13,6:PRINT "RESTART DOS AND LOAD  GRAPHICS  THEN  CAGRAPH"
  23. 420  '
  24. 430  'BUILD THE ARRAY OF COLOR NAMES
  25. 440  FOR I = 0 TO 7
  26. 450  READ COLORNAME$(I)
  27. 460  NEXT I
  28. 470  DATA BLACK,BLUE,GREEN,CYAN,RED,MAGENTA,BROWN,WHITE
  29. 480  '
  30. 490  ' READ INITIAL VALUES FOR SOME VARIABLES
  31. 500  READ DFACTOR$,DELTA,X,Y,PALETT,BACKGROUND
  32. 510  READ FOREGROUND,BOUNDARY,XP,YP
  33. 520  DATA 2,1,159,99,0,1,3,3,1,1
  34. 530  '
  35. 540  ' SET INITIAL VALUES FOR SOME VARIABLES
  36. 550  SEARCH$ =CHR$(13)
  37. 560  TILE$ = STRING$(4,255)
  38. 570  BACK$ = CHR$(0)
  39. 580  '
  40. 590  ' TITLE SCREEN
  41. 600  CLS
  42. 610  FOR I = 1 TO 2
  43. 620  '
  44. 630  ' FIRST IN RED, THEN OVERLAYED IN GREEN AND BROWN
  45. 640  IF I=1 THEN FILL = 2 ELSE FILL = 1
  46. 650  IF I=1 THEN EDGE = 2 ELSE EDGE = 3
  47. 660  IF I = 1 THEN XT = 22 ELSE XT = 25
  48. 670  IF I = 1 THEN YT = 82 ELSE YT = 80
  49. 680  '
  50. 690  ' "C"
  51. 700  DRAW "C=EDGE;BM=XT;,=YT;U40R30D5L25D30R25D5L30BE3P=FILL;,=EDGE;"
  52. 710  '
  53. 720  ' "A"
  54. 730  XT = XT + 40
  55. 740  DRAW "C=EDGE;BM=XT;,=YT;U40R30D40L5U20L20D20L5U25BR5"
  56. 750  DRAW "U10R20D10L20BG1P=FILL;,=EDGE;"
  57. 760  '
  58. 770  ' "G"
  59. 780  XT = XT + 40
  60. 790  DRAW "C=EDGE;BM=XT;,=YT;U40R30D5L25D30R20U10L5"
  61. 800  DRAW "U5R10D20L30BE1P=FILL;,=EDGE;"
  62. 810  '
  63. 820  ' "R"
  64. 830  XT = XT + 40
  65. 840  DRAW "C=EDGE;BM=XT;,=YT;U40R30D20L18F20L7H20D20L5"
  66. 850  DRAW "U25BR5U10R20D10L20BL1P=FILL;,=EDGE;"
  67. 860  '
  68. 870  ' "A"
  69. 880  XT = XT + 40
  70. 890  DRAW "C=EDGE;BM=XT;,=YT;U40R30D40L5U20L20D20L5U25BR5"
  71. 900  DRAW "U10R20D10L20BG1P=FILL;,=EDGE;"
  72. 910  '
  73. 920  ' "P"
  74. 930  XT = XT + 40
  75. 940  DRAW "C=EDGE;BM=XT;,=YT;U40R30D20L25D20L5BU25"
  76. 950  DRAW "BR5R20U10L20D10BL1P=FILL;,=EDGE;"
  77. 960  '
  78. 970  ' "H"
  79. 980  XT = XT + 40
  80. 990  DRAW "C=EDGE;BM=XT;,=YT;U40R5D15R20U15R5D40L5U20L20D20L5"
  81. 1000  DRAW "BE1P=FILL;,=EDGE;"
  82. 1010  '
  83. 1020  NEXT I
  84. 1030  '
  85. 1040  ' PUT A FRAME AROUND EDGE OF SCREEN
  86. 1050  LINE(0,0)-(319,199),3,B
  87. 1060  LINE (10,8)-(309,191),3,B
  88. 1070  PAINT (1,1),"TILE"
  89. 1080  '
  90. 1090  'VERBAL DESCRIPTION TO SCREEN
  91. 1100  LOCATE 13,7
  92. 1110  POKE &H4E, 2
  93. 1120  PRINT "COMPUTER AIDED GRAPHICS";
  94. 1130  POKE &H4E, 3
  95. 1140  '
  96. 1150  ' DISPLAY MENU
  97. 1160  LOCATE 15,8
  98. 1170  PRINT "F1 - LINE      F2 - BOX";
  99. 1180  LOCATE 16,8
  100. 1190  PRINT "F3 - CIRCLE    F4 - ERASE";
  101. 1200  LOCATE 17,8
  102. 1210  PRINT "F5 - COLORS    F6 - PAINT";
  103. 1220  LOCATE 18,8
  104. 1230  PRINT "F7 - LABEL     F8 - FILE";
  105. 1240  LOCATE 19,8
  106. 1250  PRINT "F9 - BACKUP    F10- MENU";
  107. 1260  '
  108. 1270  ' GRAB THE ENTIRE SCREEN FOR USE BY F10 FUNCTION LATER
  109. 1280  GET (0,0)-(319,199),MENU
  110. 1290  GOSUB 6790
  111. 1300  GOSUB 7790
  112. 1310  '
  113. 1320  ' GET THE FUNCTION AND CURSOR KEYS READY FOR ACTION
  114. 1330  ON KEY (1) GOSUB 1580
  115. 1340  ON KEY (2) GOSUB 1870
  116. 1350  ON KEY (3) GOSUB 2160
  117. 1360  ON KEY (4) GOSUB 2450
  118. 1370  ON KEY (5) GOSUB 2740
  119. 1380  ON KEY (6) GOSUB 3460
  120. 1390  ON KEY (7) GOSUB 5170
  121. 1400  ON KEY (8) GOSUB 5700
  122. 1410  ON KEY (9) GOSUB 6400
  123. 1420  ON KEY (10) GOSUB 6610
  124. 1430  ON KEY (11) GOSUB 6900
  125. 1440  ON KEY (12) GOSUB 7110
  126. 1450  ON KEY (13) GOSUB 7320
  127. 1460  ON KEY (14) GOSUB 7530
  128. 1470  '
  129. 1480  ' THIS IS WHERE WE HURRY UP AND WAIT A LOT
  130. 1490  WHILE NOT TIME.TO.QUIT
  131. 1500  EMPTY.THE.KEY.BUFFER$ = INKKEY$
  132. 1510    WHILE DELTA > 1
  133. 1520    DELTA = DELTA - 1
  134. 1530    WEND
  135. 1540  KEYPRT = KEYPTR MOD 14 + 1
  136. 1550  KEY (KEKYPTR) ON
  137. 1560  WEND
  138. 1570  '
  139. 1580  '-------------------------------- KEY F1, LINE CREATION
  140. 1590  ' CHECK IF ANY PENDING OPERATIONS
  141. 1600  IF CIRCLEFLAG THEN 1840
  142. 1610  IF BOXFLAG THEN 1840
  143. 1620  IF ERASEFLAG THEN 1840
  144. 1630  '
  145. 1640  ' PREPARE SCREEN
  146. 1650  GOSUB 7750
  147. 1660  GOSUB 8020
  148. 1670  '
  149. 1680  ' START OR STOP DRAWING LINE?
  150. 1690  IF LINEFLAG THEN GOSUB 8170
  151. 1700  '
  152. 1710  ' TOGGLE THE LINE DRAWING FLAG
  153. 1720  LINEFLAG = -(LINEFLAG = 0)
  154. 1730  '
  155. 1740  ' REMEMBER THE CURRENT POINT
  156. 1750  X1 = X
  157. 1760  Y1 = Y
  158. 1770  '
  159. 1780  ' REWORK THE DISPLAY
  160. 1790  GOSUB 8170
  161. 1800  GOSUB 7790
  162. 1810  '
  163. 1820  ' END OF F1 PROCESSING
  164. 1830  GOTO 1850
  165. 1840  SOUND 222,5
  166. 1850  RETURN
  167. 1860  '
  168. 1870  '-------KEY F2, BOX CREATION
  169. 1880  ' CHECK IF ANY PENDING OPERATIONS
  170. 1890  IF CIRCLEFLAG THEN 2130
  171. 1900  IF LINEFLAG THEN 2130
  172. 1910  IF ERASEFLAG THEN 2130
  173. 1920  '
  174. 1930  ' PREPARE SCREEN
  175. 1940  GOSUB 7750
  176. 1950  GOSUB 8020
  177. 1960  '
  178. 1970  ' START OR STOP DRAWING A BOX?
  179. 1980  IF BOXFLAG THEN GOSUB 8170
  180. 1990  '
  181. 2000  ' TOGGLE THE BOX DRAWING FLAG
  182. 2010  BOXFLAG = -(BOXFLAG = 0)
  183. 2020  '
  184. 2030  ' REMEMBER THE CURRENT POINT
  185. 2040  X1 = X
  186. 2050  Y1 = Y
  187. 2060  '
  188. 2070  ' REWORK THE SCREEN
  189. 2080  GOSUB 8170
  190. 2090  GOSUB 7790
  191. 2100  '
  192. 2110  ' END OF F2 PROCESSING
  193. 2120  GOTO 2140
  194. 2130  SOUND 222,5
  195. 2140  RETURN
  196. 2150  '
  197. 2160  '----KEY F3, CIRCLE CREATION
  198. 2170  ' CHECK IF ANY PENDING OPERAETIONS
  199. 2180  IF LINEFLAG THEN 2420
  200. 2190  IF BOXFLAG THEN 2420
  201. 2200  IF ERASEFLAG THEN 2420
  202. 2210  '
  203. 2220  ' PREPARE SCREEN
  204. 2230  GOSUB 7750
  205. 2240  GOSUB 8020
  206. 2250  '
  207. 2260  ' START OR STOP DRAWING CIRCLE?
  208. 2270  IF CIRCLEFLAG THEN GOSUB 8170
  209. 2280  '
  210. 2290  ' TOGGLE THE CIRCLE DRAWING FLAG
  211. 2300  CIRCLEFLAG = -(CIRCLEFLAG = 0)
  212. 2310  '
  213. 2320  ' REMEMBER THE CURRENT POINT
  214. 2330  X1 = X
  215. 2340  Y1 = Y
  216. 2350  '
  217. 2360  ' REWORK THE SCREEN
  218. 2370  GOSUB 8170
  219. 2380  GOSUB 7790
  220. 2390  '
  221. 2400  ' END OF F3 PROCESSING
  222. 2410  GOTO 2430
  223. 2420  SOUND 222,5
  224. 2430  RETURN
  225. 2440  '
  226. 2450  '------KEY F4, EASE RECTANGULAR AREA
  227. 2460  ' CHECK IF ANY PENDING OPERATIONS
  228. 2470  IF LINEFLAG THEN 2710
  229. 2480  IF BOXFLAG THEN 2710
  230. 2490  IF CIRCLEFLAG THEN 2710
  231. 2500  '
  232. 2510  ' PREPARE SCREEN
  233. 2520  GOSUB 7750
  234. 2530  GOSUB 8020
  235. 2540  '
  236. 2550  'START OR STOP ERASING AN AREA?
  237. 2560  IF ERASEFLAG THEN GOSUB 8170
  238. 2570  '
  239. 2580  ' TOGGLE THE ERASING FLAG
  240. 2590  ERASEFLAG = -(ERASEFLAG = 0)
  241. 2600  '
  242. 2610  ' REMEMBER THE CURENT POINT
  243. 2620  X1 = X
  244. 2630  Y1 = Y
  245. 2640  '
  246. 2650  ' REWORK THE SCREEN
  247. 2660  GOSUB 8170
  248. 2670  GOSUB 7790
  249. 2680  '
  250. 2690  ' END OF F4 PROCESSING
  251. 2700  GOTO 2720
  252. 2710  SOUND 222,5
  253. 2720  RETURN
  254. 2730  '
  255. 2740  '------KEY F5, COLOR SELECTION
  256. 2750  ' DEACTIVATE THE FUNCTION KEYS
  257. 2760  FOR I = 1 TO 14
  258. 2770  KEY (I) OFF
  259. 2780  NEXT I
  260. 2790  '
  261. 2800  ' CHECK IF ANY PENDING OPERATIONS
  262. 2810  IF LINEFLAG THEN 3430
  263. 2820  IF BOXFLAG THEN 3430
  264. 2830  IF CIRCLEFLAG THEN 3430
  265. 2840  IF ERASEFLAG THEN 3430
  266. 2850  '
  267. 2860  ' PREPARE SCREEN
  268. 2870  GOSUB 7750
  269. 2880  '
  270. 2890  ' GRAB CHUNK OF SCREEN SO WE CAN WORK THERE
  271. 2900  XL = 17
  272. 2910  YL = 74
  273. 2920  GET (XL,YL)-(301,124),WORK
  274. 2930  '
  275. 2940  'DRAW A FRAME AROUND THE WORK AREA
  276. 2950  LINE (XL,YL)-(301,124),1,BF
  277. 2960  LINE (22,79)-(296,119),2,BF
  278. 2970  '
  279. 2980  ' SET THE CURRENT COLOR VALUES
  280. 2990  COLOR BACKGROUND, PALETT
  281. 3000  '
  282. 3010  ' CLEAR THE WORK AREA
  283. 3020  LINE (27,84)-(291,114),0,BF
  284. 3030  '
  285. 3040  ' DISPLAY THE WORKING MENU
  286. 3050  LOCATE 12,5
  287. 3060  PRINT "<P>ALETTE...   ";PALETT;
  288. 3070  LOCATE 13,5
  289. 3080  PRINT "<B>ACKGROUND...  ";
  290. 3090  PRINT COLORNAME$(BACKGROUND MOD 8);
  291. 3100  IF BACKGROUND > 7 THEN PRINT " -BRIGHT";
  292. 3110  LOCATE 14,5
  293. 3120  PRINT "<F>OREGROUNG...  ";
  294. 3130  IF FOREGROUND = 0 THEN PRINT COLORNAME$(BACKGROUND MOD 8);
  295. 3140  IF FOREGROUND > 0 THEN PRINT COLORNAME$(2 * FOREGROUND + PALETT);
  296. 3150  '
  297. 3160  ' WAIT FOR USE RESPOUNCE
  298. 3170  SEARCH$ = "PBF"+CHR$(13)
  299. 3180  GOSUB 8670
  300. 3190  '
  301. 3200  ' CHANGE THE PALETTE?
  302. 3210  IF KEYSELECT <> 1 THEN 3260
  303. 3220  PALETT = -(PALETT = 0)
  304. 3230  GOTO 2990
  305. 3240  '
  306. 3250  ' CHANGE THE BACKGROUND?
  307. 3260  IF KEYSELECT <> 2 THEN 3310
  308. 3270  BACKGROUND = (BACKGROUND + 1) MOD 16
  309. 3280  GOTO 2990
  310. 3290  '
  311. 3300  ' CHANGE THE FOREGROUND?
  312. 3310  IF KEYSELECT <> 3 THEN 3360
  313. 3320  FOREGROUND = (FOREGROUND + 1) MOD 4
  314. 3330  GOTO 2990
  315. 3340  '
  316. 3350  ' RESTORE THE WORK AREA OF SCREEN
  317. 3360  PUT (XL,YL),WORK,PSET
  318. 3370  '
  319. 3380  ' REPLACE THE CURSOR
  320. 3390  GOSUB 7790
  321. 3400  '
  322. 3410  ' END OF F5 PROCESSING
  323. 3420  GOTO 3440
  324. 3430  SOUND 222,5
  325. 3440  RETURN
  326. 3450  '
  327. 3460  '---- KEY F6, PAINT AN AREA
  328. 3470  ' DEACTIVATE THE FUNCTION KEYS
  329. 3480  FOR I = 1 TO 14
  330. 3490  KEY (I) OFF
  331. 3500  NEXT I
  332. 3510  '
  333. 3520  ' CHECK IF ANY PENDING OPERATIONS
  334. 3530  IF LINEFLAG THEN 5030
  335. 3540  IF BOXFLAG THEN 5030
  336. 3550  IF CIRCLEFLAG THEN 5030
  337. 3560  IF ERASEFLAG THEN 5030
  338. 3570  '
  339. 3580  ' ERASE THE CURSOR
  340. 3590  GOSUB 7750
  341. 3600  '
  342. 3610  ' GRAB CHUNK OF SCREEN SO WE CAN WORK THERE
  343. 3620  XL = 17
  344. 3630  YL = 27
  345. 3640  GET (XL,YL)-(301,138),WORK
  346. 3650  '
  347. 3660  'DRAW FRAME AROUND THE WORK AREA
  348. 3670  LINE (XL,YL)-(301,138),1,BF
  349. 3680  LINE (22,32)-(296,133),2,BF
  350. 3690  '
  351. 3700  ' CLEAR THE WORK AREA
  352. 3710  LINE (27,37)-(291,127),0,BF
  353. 3720  '
  354. 3730  ' DISPLAY WORKING MENU
  355. 3740  LOCATE 6,16
  356. 3750  PRINT "* PAINT *";
  357. 3760  LOCATE 8,9
  358. 3770  PRINT "<B>OUNDARY...  ";
  359. 3780  IF BOUNDARY = 0 THEN PRINT COLORNAME$(BACKGROUND MOD 8);
  360. 3790  IF BOUNDARY > 0 THEN PRINT COLORNAME$(2 * BOUNDARY + PALETT);         
  361. 3800  LOCATE 16,10
  362. 3810  PRINT "<";CHR$(24);CHR$(25);CHR$(26);CHR$(27);">  ";
  363. 3820  PRINT "<0123>  ";"<4567>";
  364. 3830  '
  365. 3840  ' DISPLAY 4 BY 4 BLOCK OF ENLARGED PAINT PIXELS
  366. 3850  FOR XQ = 1 TO 4
  367. 3860  FOR YQ = 1 TO 4
  368. 3870  GOSUB 5120
  369. 3880  NEXT YQ,XQ
  370. 3890  '
  371. 3900  ' DRAW AN "X" IN THE CURRENT LARGE PIXEL
  372. 3910  XPT = 7 * XP + 99
  373. 3920  YPT = 7 * YP + 70
  374. 3930  CPT = (POINT(XPT,YPT) + 2) MOD 4
  375. 3940  DRAW "C=CPT;BM=XPT;,=YPT;F7BU7G7"
  376. 3950  '
  377. 3960  ' BUILD A BOX AND FILL IT WITH A SAMPLE OF CURRENT PAINT
  378. 3970  LINE (184,77)-(212,105),0,BF
  379. 3980  LINE (184,77)-(212,105),3,B
  380. 3990  BACK$ = CHR$((ASC(BACK$)+1) MOD 256)
  381. 4000  IF INSTR(TILE$,BACK$+BACK$) THEN 3990
  382. 4010  PAINT (199,88),TILE$,3,BACK$
  383. 4020  '
  384. 4030  ' WAIT FOR USER INPUT
  385. 4040  SEARCH$ = "B" + MKI$(18432) + MKI$(20480) + MKI$(19712)
  386. 4050  SEARCH$ = SEARCH$ + MKI$(19200) + "01234567" + CHR$(13)
  387. 4060  GOSUB 8670
  388. 4070  '
  389. 4080  'PUT THE CURSOR BACK ON THE SCREEN
  390. 4090  IF KEYSELECT <> 1 THEN 4140
  391. 4100  BOUNDARY = (BOUNDARY + 1) MOD 4
  392. 4110  GOTO 3710
  393. 4120  '
  394. 4130  ' CURSOR UP TO NEXT LARGE PIXEL?
  395. 4140  IF KEYSELECT <> 2 THEN 4210
  396. 4150  GOSUB 5060
  397. 4160  YP = YP + (YP > 1)
  398. 4170  GOSUB 5060
  399. 4180  GOTO 3910
  400. 4190  '
  401. 4200  ' CURSOR DOWN TO NEXT LARGE PIXEL?
  402. 4210  IF KEYSELECT <> 4 THEN 4280
  403. 4220  GOSUB 5060
  404. 4230  YP = YP - (YP < 4)
  405. 4240  GOSUB 5060
  406. 4250  GOTO 3910
  407. 4260  '
  408. 4270  'CURSOR RIGHT TO NEXT LARGE PIXEL?
  409. 4280  IF KEYSELECT <> 6 THEN 4350
  410. 4290  GOSUB 5060
  411. 4300  XP = XP - (XP < 4)
  412. 4310  GOSUB 5060
  413. 4320  GOTO 3910
  414. 4330  '
  415. 4340  ' CURSOR LEFT TO NEXT LARGE PIXEL?
  416. 4350  IF KEYSELECT <> 8 THEN 4420
  417. 4370  XP = XP + (XP >1)
  418. 4380  GOSUB 5060
  419. 4390  GOTO 3910
  420. 4400  '
  421. 4410  ' CHANGE PIXEL TO COLOR 0?
  422. 4420  IF KEYSELECT <> 10 THEN 4470
  423. 4430  CQ = 0
  424. 4440  GOTO 4820
  425. 4450  '
  426. 4460  ' CHANGE PIXEL TO COLOR 1?
  427. 4470  IF KEYSELECT <> 11 THEN 4520
  428. 4480  CQ = 1
  429. 4490  GOTO 4820
  430. 4500  '
  431. 4510  ' HANGE PIXEL TO COLOR 2?
  432. 4520  IF KEYSELECT <> 12 THEN 4570
  433. 4530  CQ = 2
  434. 4540  GOTO 4820
  435. 4550  '
  436. 4560  ' CHANGE PIXEL TO COLOR 3?
  437. 4570  IF KEYSELECT <> 13 THEN 4620
  438. 4580  CQ = 3
  439. 4590  GOTO 4820
  440. 4600  '
  441. 4610  ' CHANGE ENTIRE PAINT FIELD TO COLOR 0?
  442. 4620  IF KEYSELECT <> 14 THEN 4670
  443. 4630  TILE$ = STRING$(4,0)
  444. 4640  GOTO 3850
  445. 4650  '
  446. 4660  ' CHANGE ENTIRE PAINT FIELD TO CLOLOR 1?
  447. 4670  IF KEYSELECT <> 15 THEN 4720
  448. 4680  TILE$ = STRING$(4,85)
  449. 4690  GOTO 3850
  450. 4700  '
  451. 4710  ' CHANGE ENTIRE PAINT FIELD TO COLOR 2?
  452. 4720  IF KEYSELECT <> 16 THEN 4770
  453. 4730  TILE$ = STRING$(4,170)
  454. 4740  GOTO 3850
  455. 4750  '
  456. 4760  ' CHANGE ENTIRE PAINT FIELD TO CLOLR 3?
  457. 4770  IF KEYSELECT <> 17 THEN 4880
  458. 4780  TILE$ = STRING$(4,255)
  459. 4790  GOTO 3850
  460. 4800  '
  461. 4810  ' ALTER THE TILING BITS FOR NEW PIXEL
  462. 4820  BYTE = ASC(MID$(TILE$,YP))
  463. 4830  BYTE = (CQ*(4^(4-XP))) OR ((NOT(3*(4^(4-XP)))) AND BYTE)
  464. 4840  MID$(TILE$,YP,1) = CHR$(BYTE)
  465. 4850  GOTO 3850
  466. 4860  '
  467. 4870  ' REPLACE SCREEN IN THE WORK AREA
  468. 4880  PUT (XL,YL),WORK,PSET
  469. 4890  '
  470. 4900  'GRAB ENTIRE SCREEN IN CASE WE WANT TO BACK UP LATER
  471. 4910  XL = 0
  472. 4920  YL = 0
  473. 4930  GET (XL,YL)-(319,199),WORK
  474. 4940  '
  475. 4950  'GET OUT THE BUCKET OF PAINT
  476. 4960  PAINT (X,Y),TILE$,BOUNDARY,BACK$
  477. 4970  '
  478. 4980  'PUT THE CURSOR BACK ON THE SCREEN
  479. 4990  GOSUB 7790
  480. 5000  '
  481. 5010  ' END OF F6 PROCESSING
  482. 5020  GOTO 3440
  483. 5030  SOUND 222,5
  484. 5040  RETURN
  485. 5050  '
  486. 5060  ' SUBROUTINE, "PIXEL" AT XP,YP
  487. 5070  XQ = XP
  488. 5080  YQ = YP
  489. 5090  GOSUB 5120
  490. 5100  RETURN
  491. 5110  '
  492. 5120  'SUBROUTINE, DRAW LARGE "PIXEL" AT XQ,YQ
  493. 5130  CQ = FOREGROUND
  494. 5140  LINE (7*XQ+99,7*YQ+70)-(7*XQ+106,7*YQ+77),CQ,BF
  495. 5150  RETURN
  496. 5160  '
  497. 5170  '-----KEY F7, TEXT STRING ON SCREEN
  498. 5180  ' CHECK IF ANY PENDING OPERATIONS
  499. 5190  IF LINEFLAG THEN 5670
  500. 5200  IF BOXFLAG THEN 5670
  501. 5210  IF CIRCLEFLAG THEN 5670
  502. 5220  IF ERASEFLAG THEN 5670
  503. 5230  '
  504. 5240  ' ERASE THE CURSOR
  505. 5250  GOSUB 7750
  506. 5260  '
  507. 5270  ' GRAB ENTIRE SCREEN, SO WE CAN BACK UP LATER IF DESIRED
  508. 5280  XL = 0
  509. 5290  YL = 0
  510. 5300  GET (XL,YL)-(319,199),WORK
  511. 5310  '
  512. 5320  ' ASK USER FOR THE DESIRED TEXT
  513. 5330  CLS
  514. 5340  POKE &H4E,FOREGROUND
  515. 5350  LOCATE 3,1
  516. 5360  PRINT "ENTER YOUR TEXT..."
  517. 5370  LOCATE 1,1
  518. 5380  LINE INPUT LABEL$
  519. 5390  '
  520. 5400  'IS TEXT TOO SHORT OR TOO LONG?
  521. 5410  IF LABEL$ = "" THEN LABEL$ = " "
  522. 5420  IF LEN(LABEL$) > 40 THEN LABEL$ = LEFT$(LABEL$,40)
  523. 5430  '
  524. 5440  ' PEEL THE TEXT OFF SCREEN
  525. 5450  XLABEL = LEN(LABEL$) * 8
  526. 5460  GET (0,0)-(XLABEL-1,7),LABEL
  527. 5470  '
  528. 5480  ' REPLACE CURRENT SCREEN
  529. 5490  PUT (XL,YL),WORK,PSET
  530. 5500  '
  531. 5510  ' IS CURSOR TOO FAR TO THE RIGHT?
  532. 5520  WHILE X + XLABEL > 320
  533. 5530  X = X - 1
  534. 5540  WEND
  535. 5550  '
  536. 5560  ' IS CURSOR TOO HIGH ON THE SCREEN?5570 IF Y < 7 THEN Y = 7
  537. 5570  IF Y < 7 THEN Y = 7
  538. 5580  '
  539. 5590  ' PASTE THE TEXT AT CURENT CURSOR LOCATION
  540. 5600  PUT (X,Y-7),LABEL
  541. 5610  '
  542. 5620  ' REPLACE THE CURSOR
  543. 5630  GOSUB 7790
  544. 5640  '
  545. 5650  ' END OF F7 PROCESSING
  546. 5660  GOTO 5680
  547. 5670  SOUND 222,5
  548. 5680  RETURN
  549. 5690  '
  550. 5700  '-----KEY F8, FILE ACCESS
  551. 5710  ' CHECK IF ANY PENDING OPERATIONS
  552. 5720  IF LINEFLAG THEN 6370
  553. 5730  IF BOXFLAG THEN 6370
  554. 5740  IF CIRCLEFLAG THEN 6370
  555. 5750  IF ERASEFLAG THEN 6370
  556. 5760  '
  557. 5770  ' REMOVE CURSOR
  558. 5780  GOSUB 7750
  559. 5790  '
  560. 5800  ' GRAB ENTIRE SCREEN SO WE CAN BACK UP LATER
  561. 5810  XL = 0
  562. 5820  YL = 0
  563. 5830  GET (XL,YL)-(319,199),WORK
  564. 5840  '
  565. 5850  ' ASK USER FOR GUIDENCE...SAVE OR LOAD?
  566. 5860  CLS
  567. 5870  LOCATE 10,4
  568. 5880  PRINT "<S>AVE CURRENT WORK TO DISK"
  569. 5890  LOCATE 11,4
  570. 5900  PRINT "<L>OAD DICK FILE TO SCREEN"
  571. 5910  '
  572. 5920  'WAIT FOR USER RESPONSE
  573. 5930  SEARCH$ = "SL"+CHR$(13)
  574. 5940  GOSUB 8670
  575. 5950  '
  576. 5960  'SAVE SCREEN TO A FILE?
  577. 5970  IF KEYSELECT <> 1 THEN 6150
  578. 5980  CLS
  579. 5990  PRINT "FILE NAME FOR SAVE?"
  580. 6000  INPUT "(INCLUDE EXTENSION)... ";FILEMANE$
  581. 6010  '
  582. 6020  ' REPLACE ENTIRE SCREEN
  583. 6030  PUT (XL,YL),WORK,PSET
  584. 6040  '
  585. 6050  'COPY 16K OF SCREEN MEMORY TO BINARY FILE
  586. 6060  DEF SEG = &HB800
  587. 6070  BSAVE FILENAME$,0,&H4000
  588. 6080  '
  589. 6090  ' REPLACE THE CURSOR
  590. 6100  GOSUB 7790
  591. 6110  DEF SEG
  592. 6120  GOTO 6380
  593. 6130  '
  594. 6140  ' LOAD SCREEN DATA FROM A FILE?
  595. 6150  IF KEYSELECT <> 2 THEN 6290
  596. 6160  CLS
  597. 6170  PRINT "FILE NAME TO LOAD?"
  598. 6180  INPUT "(INCLUDE EXTENSION)... ";FILEMANE$
  599. 6190  '
  600. 6200  ' COPY 16K FROM BINARY FILE INTO SCREEN MEMORY
  601. 6210  DEF SEG = &HB800
  602. 6220  BLOAD FILENAME$
  603. 6230  '
  604. 6240  ' REPLACE THE CURSOR
  605. 6250  GOSUB 7790
  606. 6260  DEF SEG
  607. 6270  GOTO 6380
  608. 6280  '
  609. 6290  ' USER JUST PRESSED <ENTER>
  610. 6300  PUT (XL,YL),WORK,PSET
  611. 6310  '
  612. 6320  ' REPLACE CURSOR
  613. 6330  GOSUB 7790
  614. 6340  GOTO 6380
  615. 6350  '
  616. 6360  ' END OF F8 PROCESSING
  617. 6370  SOUND 222,5
  618. 6380  RETURN
  619. 6390  '
  620. 6400  '------KEY F9, BACKUP ONE STEP
  621. 6410  ' CHECK IF ANY PENDING OPERATIONS
  622. 6420  IF LINEFLAG THEN 6580
  623. 6430  IF BOXFLAG THEN 6580
  624. 6440  IF CIRLEFLAG THEN 6580
  625. 6450  IF ERASEFLAG THEN 6580
  626. 6460  '
  627. 6470  ' REMOVE CURSOR
  628. 6480  GOSUB 7750
  629. 6490  '
  630. 6500  ' REPLACE LAST WORK AREA OF SCREEN
  631. 6510  PUT (XL,YL),WORK,PSET
  632. 6520  '
  633. 6530  ' REPLACE CURSOR
  634. 6540  GOSUB 7790
  635. 6550  '
  636. 6560  ' END OF F9 PROCESING
  637. 6570  GOTO 6590
  638. 6580  SOUND 222,5
  639. 6590  RETURN
  640. 6600  '
  641. 6610  '------------KEY F10, DISPLAY MAIN MENU
  642. 6620  ' DEACTIVATE THE FUNCTION KEYS
  643. 6630  FOR I = 1 TO 14
  644. 6640  KEY (I) OFF
  645. 6650  NEXT I
  646. 6660  '
  647. 6670  ' CHECK IF ANY PENDING OPERATIONS
  648. 6680  IF LINEFLAG THEN 6870
  649. 6690  IF BOXFLAG THEN 6870
  650. 6700  IF CIRCLEFLAG THEN 6870
  651. 6710  IF ERASEFLAG THEN 6870
  652. 6720  '
  653. 6730  ' GRAB ENTIRE SCREEN TEMPORARILY
  654. 6740  GET (0,0)-(319,199),WORK
  655. 6750  '
  656. 6760  ' PUT MAIN MENU ON SCREEN
  657. 6770  PUT (0,0),MENU,PSET
  658. 6780  '
  659. 6790  ' WAIT FOR USER BEFORE CONTINUING
  660. 6800  GOSUB 8670
  661. 6810  '
  662. 6820  ' REPLACE CURRENT SCREEN
  663. 6830  PUT (0,0),WORK,PSET
  664. 6840  '
  665. 6850  ' END FUNTION 10 PROCESSING
  666. 6860  GOTO 6880
  667. 6870  SOUND 222,5
  668. 6880  RETURN
  669. 6890  '
  670. 6900  '----KEY F11, CURSOR UP
  671. 6910  ' REMOVE CURSOR
  672. 6920  GOSUB 7750
  673. 6930  '
  674. 6940  ' ERASE ANY PENDING LINES, BOXS, ECT.
  675. 6950  GOSUB 8020
  676. 6960  '
  677. 6970  ' MOVE THE CURSOR LOCATION UP
  678. 6980  Y = Y - DELTA
  679. 6990  IF Y < 0 THEN Y = 0
  680. 7000  IF DELTA < 9 THEN DELTA = DELTA + DFACTOR
  681. 7010  '
  682. 7020  ' REDRAW ANY PENDING LINES., BOXES, ETC.
  683. 7030  GOSUB 8170
  684. 7040  '
  685. 7050  ' REDRAW THE CURSOR
  686. 7060  GOSUB 7790
  687. 7070  '
  688. 7080  ' END OF F11 PROCESSING
  689. 7090  RETURN
  690. 7100  '
  691. 7110  '----KEY F12, CURSOR LEFT
  692. 7120  ' REMOVE THE CURSOR
  693. 7130  GOSUB 7750
  694. 7140  '
  695. 7150  ' ERASE ANY PENDING LINES, BOXES,ETC.
  696. 7160  GOSUB 8020
  697. 7170  '
  698. 7180  ' MOVE THE CURSOR LOCATION LEFT
  699. 7190  X = X - DELTA
  700. 7200  IF X < 9 THEN X = 0
  701. 7210  IF DELTA < 9 THEN DELTA = DELTA + DFACTOR
  702. 7220  '
  703. 7230  ' REDRAW ANY PENDING LINES, BOXES, ETC.
  704. 7240  GOSUB 8170
  705. 7250  '
  706. 7260  ' REDRAW THE CURSOR
  707. 7270  GOSUB 7790
  708. 7280  '
  709. 7290  ' END OF F12 PROCESSING
  710. 7300  RETURN
  711. 7310  '
  712. 7320  '-----KEKY F13, CURSOR RIGHT
  713. 7330  'ERASE CURSOR
  714. 7340  GOSUB 7750
  715. 7350  '
  716. 7360  ' ERASE ANY PENDING LINES, BOXES, ETC.
  717. 7370  GOSUB 8020
  718. 7380  '
  719. 7390  ' MOVE CURSOR LOCATION TO THE RIGHT
  720. 7400  X = X + DELTA
  721. 7410  IF X > 319 THEN X = 319
  722. 7420  IF DELTA < 9 THEN DELTA = DELTA + DFACTOR
  723. 7430  '
  724. 7440  ' REDRAW ANY PENDING LINES, BOXES, ETC.
  725. 7450  GOSUB 8170
  726. 7460  '
  727. 7470  ' REDRAW CURSOR
  728. 7480  GOSUB 7790
  729. 7490  '
  730. 7500  ' END OF F13 PROCESSING
  731. 7510  RETURN
  732. 7520  '
  733. 7530  '---KEY F14, CURSOR DOWN
  734. 7540  ' ERASE CURSOR
  735. 7550  GOSUB 7750
  736. 7560  '
  737. 7570  ' ERASE ANY PENDING LINES. BOXES, ETC.
  738. 7580  GOSUB 8020
  739. 7590  '
  740. 7600  ' MOVE CURSOR LOCATION DOWN
  741. 7610  Y = Y + DELTA
  742. 7620  IF Y > 199 THEN Y = 199
  743. 7630  IF DELTA < 9 THEN DELTA = DELTA + DFACTOR
  744. 7640  '
  745. 7650  ' REDRAW ANY PENDING LINES BOXES, ETC.
  746. 7660  GOSUB 8170
  747. 7670  '
  748. 7680  ' REDRAW CURSOR
  749. 7690  GOSUB 7790
  750. 7700  '
  751. 7710  ' END OF F14 PROCESSING
  752. 7720  RETURN
  753. 7730  '
  754. 7740  '----SHARED SUBROUTINES
  755. 7750  ' ERASE THE CURSOR
  756. 7760  PUT (XCG,YCG),CURSRBOX,PSET
  757. 7770  RETURN
  758. 7780  '
  759. 7790  ' DRAW CURSON AT X,Y
  760. 7800  ' COMPUTE LEFT EDGE OF AREA UNDER CURSOR TO PRESERVE
  761. 7810  XCG = X - 7
  762. 7820  IF XCG < 0 THEN XCG = 0
  763. 7830  IF XCG > 305 THEN XCG = 305
  764. 7840  '
  765. 7850  ' COMPUTE TOP EDGE OF AREA UNDER CURSOR TO PRESERVE
  766. 7860  YCG = Y - 7
  767. 7870  IF YCG < 0 THEN YCG = 0
  768. 7880  IF YCG > 185 THEN YCG = 185
  769. 7890  '
  770. 7900  ' GRAB AREA UNDER CURSOR
  771. 7910  GET (XCG,YCG)-(XCG+14,YCG+14),CURSRBOX
  772. 7920  '
  773. 7930  'DETERMINE REASONABLE COLOR FOR CURSOR
  774. 7940  CURSRCLR = (POINT(X,Y) + 2) MOD 4
  775. 7950  '
  776. 7960  ' DRAW THE CURSOR
  777. 7970  DRAW "C=CURSRCLR;BM=X;,=Y;L6R12BH6D12"
  778. 7980  '
  779. 7990  ' END OF CURSOR DRAWING SUBROUTINE
  780. 8000  RETURN
  781. 8010  '
  782. 8020  'CHECK FOR ERASING LINES, CIRCLESL, STC.
  783. 8030  IF LINEFLAG THEN 8120
  784. 8040  IF BOXFLAG THEN 8120
  785. 8050  IF CIRCLEFLAG THEN 8120
  786. 8060  IF ERASEFLAG THEN 8120
  787. 8070  '
  788. 8080  ' IF NO FLAGS THEN DON'T DO ANYTHING
  789. 8090  GOTO 8150
  790. 8100  '
  791. 8110  'PLACE THE WORK AREA BACK ON SCREEN
  792. 8120  PUT (XL,YL),WORK,PSET
  793. 8130  '
  794. 8140  ' END OF REPLACING-WORK-AREA SUBROUTINE
  795. 8150  RETURN
  796. 8160  '
  797. 8170  ' CHECK FOR DRAWING LINES, CIRCLES, ETC.
  798. 8180  IF LINEFLAG THEN 8240
  799. 8190  IF BOXFLAG THEN 8240
  800. 8200  IF ERASEFLAG THEN 8240
  801. 8210  GOTO 8430
  802. 8220  '
  803. 8230  ' GRAB CORNER COORDINATES OF WORK AREA
  804. 8240  XL = X
  805. 8250  YL = Y
  806. 8260  XL1 = X1
  807. 8270  YL1 = Y1
  808. 8280  '
  809. 8290  ' SHUFFLE COORDINATES INTO PROPER ORDER
  810. 8300  IF XL > XL1 THEN SWAP XL,XL1
  811. 8310  IF YL > YL1 THEN SWAP YL,YL1
  812. 8320  '
  813. 8330  ' GRAB THE WORK AREA FOR SAFEKEEPING
  814. 8340  GET (XL,YL)-(XL1,YL1),WORK
  815. 8350  '
  816. 8360  ' DO WHAT NEEDS TO BE DONE
  817. 8370  IF LINEFLAG THEN LINE (X,Y)-(X1,Y1),FOREGROUND
  818. 8380  IF BOXFLAG THEN LINE (X,Y)-(X1,Y1),FOREGROUND,B
  819. 8390  IF ERASEFLAG THEN PUT (XL,YL),WORK
  820. 8400  GOTO 8650
  821. 8410  '
  822. 8420  ' THE CIRCLE IS HANDLED SLIGHTLY DIFFERENTLY
  823. 8430  IF CIRCLEFLAG = 0 THEN 8650
  824. 8440  RADIUS = SQR((X1-X)^2 + (6*(Y1-Y)/5)^2)
  825. 8450  '
  826. 8460  ' GRAB THE CORONERS OF THE WORK AREA
  827. 8470  XL = X1 - RADIUS
  828. 8480  YL = Y1 - RADIUS
  829. 8490  XL1 = X1 + RADIUS
  830. 8500  YL1 = Y1 + RADIUS
  831. 8510  '
  832. 8520  ' CHECK FOR CORNERS THA ARE OFF-SCREEN
  833. 8530  IF XL < 0 THEN XL = 0
  834. 8540  IF YL < 0 THEN YL = 0
  835. 8550  IF XL1 > 319 THEN XL1 = 319
  836. 8560  IF YL1 > 199 THEN YL1 = 199
  837. 8570  '
  838. 8580  ' GRAB THE WORK AREA FOR SAFEKEEPING
  839. 8590  GET (XL,YL)-(XL1,YL1),WORK
  840. 8600  '
  841. 8610  ' DRAW THE CIRCLE
  842. 8620  CIRCLE (X1,Y1),RADIUS,FOREGROUND
  843. 8630  '
  844. 8640  ' END OF SUBROUTINE FOR DRAWING LINE, BOX,ETC.
  845. 8650  RETURN
  846. 8660  '
  847. 8670  ' SUBROUTINE, WAIT FOR USER BEFORE CONTINUING
  848. 8680  ' DUMP ANY BUFFERED KEYS
  849. 8690  WHILE LEN(INKEY$)
  850. 8700  WEND
  851. 8710  '
  852. 8720  ' GRAB AREA OF SCREEN SHERE MESSAGE WILL BE DISPLAYED
  853. 8730  GET (75,173)-(243,185),MESSAGE
  854. 8740  '
  855. 8750  ' ERASE AREA WHERE MESSAGE WILL BE DISPLAYED
  856. 8760  LINE (75,173)-(243,185),0,BF
  857. 8770  '
  858. 8780  'CHECK FOR ANY KEY PRESSES
  859. 8790  K$ = INKEY$
  860. 8800  IF K$ = "" THEN 8920
  861. 8810  '
  862. 8820  ' CONVERT TO UPPER CASE
  863. 8830  IF K$ < "a" THEN 8880
  864. 8840  IF K$ > "z" THEN 8880
  865. 8850  K$ = CHR$(ASC(K$)-32)
  866. 8860  '
  867. 8870  ' MATCH ANY POSSIBLE CHOICES AS INDICATED IN SEARCH$?
  868. 8880  KEYSELECT = INSTR(SEARCH$,K$)
  869. 8890  IF KEYSELECT THEN 9080
  870. 8900  '
  871. 8910  ' HAS ANOTHER SECOND ELAPSED?
  872. 8920  IF T$ = TIME$ THEN 8790
  873. 8930  T$ = TIME$
  874. 8940  '
  875. 8950  ' ONCE PER SECOND WE'LL CHANGE MESSAGE COLOR
  876. 8960  MCOLOR = 1 + MCOLOR MOD 3
  877. 8970  POKE &H4E, MCOLOR
  878. 8980  '
  879. 8990  ' DISPLAY THE MESSAGE
  880. 9000  LOCATE 23,11
  881. 9010  PRINT "PRESS "CHR$(17);"  TO CONTINUE";
  882. 9020  DRAW "C=MCOLOR;BM135,179R7U3"
  883. 9030  '
  884. 9040  ' GO BACK AND CHECK KEY BUFFER AGAIN
  885. 9050  GOTO 8790
  886. 9060  '
  887. 9070  ' RESTORE MESSAGE AREA TO SCREEN
  888. 9080  PUT (75,173),MESSAGE,PSET
  889. 9090  '
  890. 9100  ' SET TEXT COLOR TO ORIGINAL VALUE
  891. 9110  POKE &H4E, 3
  892. 9120  '
  893. 9130  ' END OF WAIT-FOR-USER SUBROUTINE
  894. 9140  RETURN
  895.